:- import "%%/lib/data.sl" #


-- Structure Accessors --

structure.define .struct :-
	nth .struct 0 .tag,
	concat .tag .str,
	lower .str .structName
	,
	assertInitializer .struct .tag .structName
	,
	forall (nth .struct .n .field, .n > 0) (
		field.nameType .field .fieldName .type,
		assertAccessors .structName .n .fieldName .type
	) #

assertInitializer .struct .tag .structName :-
	length .struct .len,
	memberOperators .struct .obj 1 .news .disposes,
	openList.terminate .news,
	openList.terminate .disposes
	,
	concatToAtom .structName ".new" .newRoutine,
	assert (
		.newRoutine .obj :- length .obj .len, nth .obj 0 .tag, .news
	),
	concatToAtom .structName ".dispose" .disposeRoutine,
	assert (
		.disposeRoutine .obj :- .disposes
	),
	#

memberOperators .struct . .n . . :-
	length .struct .n ! #
memberOperators .struct .obj .n .news .disposes :-
	nth .struct .n .field,
	field.nameType .field . .type,
	memberOperator .obj .n .type .news .disposes,
	let .n1 (.n + 1),
	memberOperators .struct .obj .n1 .news .disposes #

memberOperator .obj .n global .news .disposes :-
	openList.extend .news (temporary .t, nth .obj .n .t, .),
	openList.extend .disposes (nth .obj .n .t, unset .t, .) ! #
memberOperator . . . . . #

assertAccessors .structName .n .fieldName ref :-
	assertAccessor .structName .n .fieldName #
assertAccessors .structName .n .fieldName list :-
	assertAccessor .structName .n .fieldName,
	assertListAccessor .structName .n .fieldName #
assertAccessors .structName .n .fieldName set :-
	assertAccessor .structName .n .fieldName,
	assertSetAccessor .structName .n .fieldName #
assertAccessors .structName .n .fieldName map :-
	assertAccessor .structName .n .fieldName,
	assertMapAccessor .structName .n .fieldName #
assertAccessors .structName .n .fieldName global :-
	assertGlobalAccessors .structName .n .fieldName #

assertAccessor .structName .n .fieldName :-
	concatToAtom .structName "." .fieldName .routine,
	assert (.routine .obj .fld :- nth .obj .n .fld) #

assertListAccessor .structName .n .fieldName :-
	elementRoutineName .structName .fieldName .routine,
	assert (
		.routine .obj .elm :- nth .obj .n .list, list.member .list .elm
	) #

assertSetAccessor .structName .n .fieldName :-
	elementRoutineName .structName .fieldName .routine,
	assert (
		.routine .obj .elm :-
			nth .obj .n .list, once (list.member .list .elm)
	) #

assertMapAccessor .structName .n .fieldName :-
	elementRoutineName .structName .fieldName .routine,
	assert (
		.routine .obj .k .v :-
			nth .obj .n .list,
			once (list.member .list (.k .v0)),
			.v = .v0
	) #

assertGlobalAccessors .structName .n .fieldName :-
	concatToAtom .structName "." .fieldName .getRoutine,
	assert (
		.getRoutine .obj .elm :- nth .obj .n .a, get .a .elm
	),
	concatToAtom .structName "." .fieldName "Become" .setRoutine,
	assert (
		.setRoutine .obj .elm :- nth .obj .n .a, set .a .elm
	),
	concatToAtom .structName "." .fieldName "Unset" .unsetRoutine,
	assert (
		.unsetRoutine .obj :- nth .obj .n .a, unset .a
	) #

elementRoutineName .structName .fieldName .routine :-
	substr .fieldName 0 -1 .withoutS,
	concatToAtom .structName "." .withoutS .routine #

field.nameType .name:.type .name .type :- ! #
field.nameType .name .name ref #

concatToAtom .s1 .s2 .atom :-
	concat .s1 .s2 .s, parse .s .atom #
concatToAtom .s1 .s2 .s3 .atom :-
	concat .s1 .s2 .s3 .s, parse .s .atom #
concatToAtom .s1 .s2 .s3 .s4 .atom :-
	concat .s1 .s2 .s3 .s4 .s, parse .s .atom #
